home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1987 November / Ahoy_Magazine_87-11_1987_Double_L.d64 / Amazement 64 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  5KB  |  169 lines
  1. 10 rem ---------------------------------
  2. 11 rem         amazement
  3. 12 rem     rupert report #47
  4. 13 rem
  5. 14 rem       c-128 / c-64
  6. 15 rem c-64 users see notes at line 2000
  7. 16 rem
  8. 17 rem ---------------------------------
  9. 20 rem ================ initialization =
  10. 30 print"[147]"
  11. 40 false=0 : true=not false
  12. 50 nc=100       :rem # cells
  13. 60 sq=int(sqr(nc)+.5)      :rem width of square
  14. 70 dim mv(nc,1),ms(nc,4)  :rem moves and maze structure
  15. 80 dim x(nc),y(nc)           :rem screen positions
  16. 90 gosub 1320    :rem get maze structure
  17. 100 gosub 1500 :rem get screen positions
  18. 110 gosub 1700    :rem  draw screen
  19. 120 dly=100       :rem  move delay
  20. 130 for n=1 to nc : if ms(n,0)=3 then c=n : n=nc
  21. 140 next n   :rem  find starting cell
  22. 150 if c=0 then print"no starting cell" : end
  23. 160 rem ==================== main loop =
  24. 170 gosub 300   :rem  pick move
  25. 180 gosub 400   :rem  check move
  26. 190 gosub 900   :rem  update screen
  27. 200 if not xit and not nosoln then 170
  28. 210 a=0:b=21:ch$="":gosub 2200
  29. 220 if nosoln then print"no solution" :  end
  30. 230 gosub 3010  :rem retrace solution
  31. 240 a=0:b=21:ch$="":gosub 2200
  32. 250 end
  33. 260 rem ================================
  34. 300 rem -------------------- pick move -
  35. 310 gdmove=true       :rem assume good
  36. 320 mv(c,0)=mv(c,0)+1     :rem increment move direction; c=current cell
  37. 330 dir=mv(c,0)   :rem current direction
  38. 340 return
  39. 350 rem
  40. 400 rem ------------------- check move -
  41. 410 bkup=false   :rem assume no backup
  42. 420 if dir>4 then gosub 800 : goto 490 : rem must back up
  43. 430 nxtcell=ms(c,dir)   :rem next cell #
  44. 440 cs=ms(nxtcell,0)    :rem cell status
  45. 450 rem  cs=0,2,3 invalid move
  46. 460 rem  cs=1     valid move
  47. 470 rem  cs=4     end of maze
  48. 480 on cs+1 gosub 600,500,600,600,700
  49. 490 return       :rem  to main loop
  50. 500 rem ------------------- valid move -
  51. 510 mv(c,0)=dir       :rem set fwd link
  52. 520 mv(nxtcell,1)=c   :rem set back link
  53. 530 ms(nxtcell,0)=2   :rem status=used
  54. 540 c=nxtcell         :rem current cell
  55. 550 return
  56. 600 rem ----------------- invalid move -
  57. 610 gdmove=false
  58. 620 if ms(c,0)=3 and mv(c,0)=4 then nosoln=true
  59. 630 return
  60. 700 rem ------------------------- done -
  61. 710 mv(c,0)=dir       :rem set fwd link
  62. 720 mv(nxtcell,1)=c   :rem set back link
  63. 730 c=nxtcell
  64. 740 xit=true
  65. 750 return
  66. 800 rem ----------------------- backup -
  67. 810 restart=false :rem assume no restart
  68. 820 nxtcell=mv(c,1)   :rem use back link
  69. 830 mv(c,0)=0      :rem restore fwd link
  70. 840 ms(c,0)=1         :rem set status to available
  71. 850 c0=c            :rem save old cell #
  72. 860 c=nxtcell
  73. 870 bkup=true
  74. 880 if ms(c,0)=3 then restart=true : if mv(c,0)=4 then nosoln=true
  75. 890 return
  76. 900 rem ---------------- screen update -
  77. 910 c$="o"
  78. 920 if not gdmove then goto 1060
  79. 930 if xit then c$="e" : goto 1000
  80. 940 if not bkup then goto 1000
  81. 950 if nosoln or restart then c$="s"
  82. 960 rem  restore cell c0 to unused
  83. 970 a=x(c0):b=y(c0):ch$=" ":gosub 2200
  84. 980 a=x(c0):b=y(c0):ch$="*":gosub 2200
  85. 990 rem  move cursor to cell c
  86. 1000 for n=1 to 2
  87. 1010 a=x(c):b=y(c):ch$=" ": gosub 2200
  88. 1020 for p=1 to dly : next
  89. 1030 a=x(c):b=y(c):ch$=c$ : gosub 2200
  90. 1040 for p=1 to dly : next
  91. 1050 next n
  92. 1060 return    :rem to main
  93. 1070 rem ===============================
  94. 1100 rem       maze data structure
  95. 1110 rem
  96. 1120 rem     ms(c,n): c=cell #, n=0-4
  97. 1130 rem n=0: current cell status
  98. 1140 rem  0=no access,1=available,2=used
  99. 1150 rem    3=start, 4=end
  100. 1160 rem n=1-4: cell #'s in directions
  101. 1170 rem        1-4 from cell c;
  102. 1180 rem    1=up, 2=rt, 3=down, 4=left
  103. 1190 rem -------------------------------
  104. 1200 rem  ms(c,0) cell status data
  105. 1210 data 1,0,0,0,1,1,1,1,1,1
  106. 1220 data 1,1,1,1,0,0,1,0,1,0
  107. 1230 data 1,0,0,1,1,0,1,0,1,0
  108. 1240 data 1,0,0,0,1,0,1,0,1,0
  109. 1250 data 0,1,1,1,1,0,1,0,1,0
  110. 1260 data 1,1,0,0,1,0,1,0,1,0
  111. 1270 data 1,0,0,0,0,0,1,0,1,1
  112. 1280 data 1,0,0,0,0,0,1,0,0,1
  113. 1290 data 3,1,1,1,1,1,1,0,1,1
  114. 1300 data 1,0,0,0,0,4,0,1,1,0
  115. 1310 rem         read cell status data
  116. 1320 for n=1 to nc : read ms(n,0) : next
  117. 1330 rem         calc adjacent cell #'s
  118. 1340 for n=1 to nc : mod%=n-sq*int(n/sq+.01)
  119. 1350 ms(n,1)=n-sq : if n<sq+1 then ms(n,1)=0
  120. 1360 ms(n,2)=n+1 : if mod%=0 then ms(n,2)=0
  121. 1370 ms(n,3)=n+sq : if n>nc-sq then ms(n,3)=0
  122. 1380 ms(n,4)=n-1 : if mod%=1 then ms(n,4)=0
  123. 1390 next n
  124. 1400 return
  125. 1500 rem --- get cell screen locations -
  126. 1510 row=1
  127. 1520 col=1
  128. 1530 for c=1 to nc step sq
  129. 1540 for n=c to c+sq-1
  130. 1550 y(n)=row
  131. 1560 x(n)=col : col=col+3
  132. 1570 next n
  133. 1580 row=row+2 : col=1
  134. 1590 next c
  135. 1600 return
  136. 1700 rem ----------------- draw screen -
  137. 1710 print chr$(147)
  138. 1720 for n=1 to nc
  139. 1730 c$="." : if ms(n,0)=1 then c$="*"
  140. 1740 if ms(n,0)=3 then c$="s"
  141. 1750 if ms(n,0)=4 then c$="e"
  142. 1760 a=x(n):b=y(n):ch$=c$ : gosub 2200
  143. 1770 next
  144. 1780 return
  145. 2000 rem =============================
  146. 2010 rem >>> notes for c-64 users:
  147. 2020 rem change the   'char'
  148. 2030 rem statements in lines  210, 240,
  149. 2040 rem  970, 980, 1010, 1030, & 1760
  150. 2100 rem to the following:
  151. 2110 rem  210 a=0:b=21:ch$="":gosub 2200
  152. 2120 rem  240 a=0:b=21:ch$="":gosub 2200
  153. 2130 rem  970 a=x(c0):b=y(c0):ch$=" ":gosub 2200
  154. 2140 rem  980 a=x(c0):b=y(c0):ch$="*":gosub 2200
  155. 2150 rem 1010 a=x(c):b=y(c):ch$=" ": gosub 2200
  156. 2160 rem 1030 a=x(c):b=y(c):ch$=c$ : gosub 2200
  157. 2170 rem 1760 a=x(n):b=y(n):ch$=c$ : gosub 2200
  158. 2180 rem =============================
  159. 2190 rem  c-64 only  >>>>>>>>
  160. 2200 poke 214,b-1 : print
  161. 2210 poke 211,a : print ch$ : return
  162. 2220 rem =============================
  163. 3000 rem --- retrace the solution ----
  164. 3010 c$="-"
  165. 3020 c=mv(c,1) :if ms(c,0)<>3 then gosub 1000 : goto 3020
  166. 3030 c$="+"
  167. 3040 c=ms(c,mv(c,0)) :if ms(c,0)<>4 then gosub 1000 : goto 3040
  168. 3050 return
  169.